Licence Creative Commons

1. Préparatifs

J’installe ma session de travail

setwd("~/Documents/github/UNIGE/32M7129/Cours_03")
monDossier="~/Documents/github/UNIGE/32M7129/Cours_03"
#je charge les données que l'enseignant a préparé pour éviter les problèmes
#load("Cours_Geneve_3.RData")

Première chose à faire: importer le corpus qui se trouve dans le dossier cours 3. Comme il s’agit d’un csv, nous utilisons la fonction read.csv() Le corpus que nous importons est une collection de blocs d’environ 1000 mots lemmatisés. (notez la présence de lignes commençant par un dièse. Il s’agit d’un commentaire: quand il est utilisé, la ligne n’est pas interprétée par R)

theatre = "moliere_racine.tsv"
# le paramètre `header` permet de signaler que la première ligne contient le nom des colonnes
# le paramètre `sep` permet d'indiquer comment sont marquées les colonnes. La regex `\t` indique que nous utilisons des tabulations (notre fichier est donc en fait un `tsv` et non un vrai `csv`).
# le paramètre fileEncoding permet d'avoir des charactères encodés en UTF8 (si vous avez windows, sans cette option le résultat de l'import peut être problématique)
theatre <- read.csv(theatre, header=TRUE, sep = "\t", quote = '',fill = TRUE, fileEncoding="UTF-8")

Je peux jeter un coup d’œil aux données brutes (on ne m’affiche que les première entrées de chaque colonne par commodité)

str(theatre)
## 'data.frame':    724 obs. of  8 variables:
##  $ auteur     : chr  "\"MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)\"" "\"MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)\"" "\"MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)\"" "\"MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)\"" ...
##  $ titre      : chr  "\"AMPHITRYON, COMÉDIE\"" "\"AMPHITRYON, COMÉDIE\"" "\"AMPHITRYON, COMÉDIE\"" "\"AMPHITRYON, COMÉDIE\"" ...
##  $ date       : chr  "\"1668\"" "\"1668\"" "\"1668\"" "\"1668\"" ...
##  $ genre      : chr  "\"Comédie\"" "\"Comédie\"" "\"Comédie\"" "\"Comédie\"" ...
##  $ inspiration: chr  "\"mythe grec\"" "\"mythe grec\"" "\"mythe grec\"" "\"mythe grec\"" ...
##  $ structure  : chr  "\"Trois actes, un prologue\"" "\"Trois actes, un prologue\"" "\"Trois actes, un prologue\"" "\"Trois actes, un prologue\"" ...
##  $ type       : chr  "\"vers\"" "\"vers\"" "\"vers\"" "\"vers\"" ...
##  $ texteLemmat: chr  "\" tout  beau  charmant  nuit  daigner  vous  arrêter  il  être  certain  secours  que  de  vous  on  désirer  "| __truncated__ "\" de_le  nuit  que  à  son  transport  vous  donner  plus  de  espace  et  retarder  le  naissance  de_le  jou"| __truncated__ "\" jamais  croire  raconter  je  sosie  un  tel  événement  \"  \"  je  le  vouloir  bien  madame  et  sans  je"| __truncated__ "\" être  son  valet  tu  je  son  valet  sans  doute  valet  de  amphitryon  de  amphitryon  de  il  ton  nom  "| __truncated__ ...

Je peux aussi les regarder dans un tableau directement dans RStudio. On remarque que les colonnes ont des noms: “auteur”, “titre”…

View(theatre)

Je peux sélectionner juste une colonne (ici “auteur”). Afin de ne pas tout afficher j’utilise la fonction head() pour ne montrer que les premières entrées:

head(theatre$auteur)
## [1] "\"MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)\""
## [2] "\"MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)\""
## [3] "\"MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)\""
## [4] "\"MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)\""
## [5] "\"MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)\""
## [6] "\"MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)\""
# Je peux augmenter le nombre de résultat affiché en indiquant le chiffre souhaité de la manière suivante:
#head(theatre$auteur,10)
#Pour les dernières entrées, il existe une fonction `tail`
#tail(theatre$auteur)

Toutes les colonnes sont des métadonnées, sauf theatre$texteLemmat qui contient des “morceaux” de pièces de 1000 mots afin de simplifier le travail (nous allons y revenir). Il va falloir transformer le contenu de cette colonne en matrice terme-document (Document Term Matrix), c’est-à-dire créer un tableau avec une colonne pour chaque mot de mon corpus, et un rang par texte de mon corpus.

mot1 mot2 mot3
Texte1 1 12 9
Texte2 1 154 4

C’est le principe d’une approche bag of words, c’est à dire par “sac de mots”: les mots ne sont pas pris dans leur contexte, uniquement par leur fréquence. Cela peut paraître un peu rustre, mais c’est très efficace.

#Je charge deux nouvelles librairies pour le _text mining_ qui me permettent de créer ma matrice
if(!require("tm")){s
  install.packages("tm")
  library("tm")
}
## Le chargement a nécessité le package : tm
## Le chargement a nécessité le package : NLP
if(!require("tidytext")){
  install.packages("tidytext")
  library("tidytext")
}
## Le chargement a nécessité le package : tidytext
# Je transforme mes textes en corpus avec la fonction `corpus()`, un objet de classe `corpus` manipulable dans `R` contenant des données et des métadonnées
#La fonction `VectorSource` transforme chaque document en vecteur
corpus <- Corpus(VectorSource(theatre$texteLemmat), readerControl = list(language = "fr"))
# J'affiche les informations à propos de ce corpus
corpus
## <<SimpleCorpus>>
## Metadata:  corpus specific: 1, document level (indexed): 0
## Content:  documents: 724

Je peux désormais “utiliser” cet objet:

#je compte le nombre de colonne dans ma matrice
ncol(as.matrix(DocumentTermMatrix(corpus)))
## [1] 8896
#J'affiche le premier vecteur de mon objet `corpus`:
corpus[[1]][[1]]
## [1] "\" tout  beau  charmant  nuit  daigner  vous  arrêter  il  être  certain  secours  que  de  vous  on  désirer  et  je  avoir  deux  mot  à  vous  dire  de  le  part  de  Jupiter  ah  ah  ce  être  vous  seigneur  Mercure  qui  vous  avoir  deviner  là  dans  ce  posture  mon  foi  je  trouver  las  pour  ne  pouvoir  fournir  à_le  différent  emploi  où  Jupiter  je  engager  je  je  être  doucement  asseoir  sur  ce  nuage  pour  vous  attendre  venir  vous  vous  moquer  Mercure  et  vous  ne  y  songer  pas  seoir  il  bien  à  de_le  dieu  de  dire  que  il  être  las  le  dieu  être  il  de  fer  non  mais  il  falloir  sans  cesse  garder  le  decorum  de  le  divinité  il  être  de  certain  mot  dont  le  usage  rabaisser  ce  sublime  qualité  et  que  pour  leur  indignité  il  être  bon  que  à_le  homme  on  laisser  à  votre  aise  vous  en  parler  et  vous  avoir  le  beau  un  chaise  roulant  où  par  deux  bon  cheval  en  dame  nonchalant  vous  vous  faire  traîner  partout  où  vous  vouloir  mais  de  je  ce  ne  être  pas  de  même  et  je  ne  pouvoir  vouloir  dans  mon  destin  fatal  à_le  poète  assez  de  mal  de  leur  impertinence  extrême  de  avoir  par  un  injuste  loi  dont  on  vouloir  maintenir  le  usage  à  chaque  dieu  dans  son  emploi  donner  quelque  allure  en  partage  et  de  je  laisser  à  pied  je  comme  un  messager  de  village  je  qui  être  comme  on  savoir  en  terre  et  dans  le  ciel  le  fameux  messager  de_le  souverain  de_le  dieu  et  qui  sans  rien  exagérer  par  tout  le  emploi  que  il  je  donner  avoir  besoin  plus  que  personne  de  avoir  de  quoi  je  voiturer  que  vouloir  vous  faire  à  cela  le  poète  faire  à  leur  guise  ce  ne  être  pas  le  seul  sottise  que  on  voir  faire  à  ce  messieurs  là  mais  contre  il  toutefois  votre  âme  à  tort  se  irriter  et  votre  aile  à_le  pied  être  un  don  de  leur  soin  oui  mais  pour  aller  plus  vite  être  ce  que  on  se  en  las  moins  laisser  cela  seigneur  Mercure  et  savoir  ce  dont  il  se  agir  ce  être  Jupiter  comme  je  vous  le  avoir  dire  qui  de  votre  manteau  vouloir  le  faveur  obscur  pour  certain  doux  aventure  que  un  nouveau  amour  il  fournir  son  pratique  je  croire  ne  vous  être  pas  nouvelle  bien  souvent  pour  le  terre  il  négliger  le  ciel  et  vous  ne  ignorer  pas  que  ce  maître  de_le  dieu  aimer  à  se  humaniser  pour  de_le  beauté  mortel  et  savoir  cent  tour  ingénieux  pour  mettre  à  bout  le  plus  cruel  un  œil  de  Alcmène  il  avoir  sentir  le  coup  et  tandis  que  à_le  milieu  de_le  béotique  plaine  amphitryon  son  époux  commander  à_le  troupe  thébaine  il  en  avoir  prendre  le  forme  et  recevoir  là-dessous  un  soulagement  à  son  peine  dans  le  possession  de_le  plaisir  le  plus  doux  le  état  de_le  marier  à  son  feu  être  propice  le  hymen  ne  le  avoir  joindre  que  depuis  quelque  jour  et  le  jeune  chaleur  de  leur  tendre  amour  avoir  faire  que  Jupiter  à  ce  beau  artifice  se  être  aviser  de  avoir  recours  son  stratagème  ici  se  trouver  salutaire  mais  près  de  maint  objet  chérir  pareil  déguisement  être  pour  ne  rien  faire  et  ce  ne  être  pas  partout  un  bon  moyen  de  plaire  que  le  figure  de  un  mari  je  admirer  Jupiter  et  je  ne  comprendre  pas  tout  le  déguisement  qui  il  venir  en  tête  il  vouloir  goûter  par  là  tout  sorte  de  état  et  ce  être  agir  en  dieu  qui  ne  être  pas  bête  dans  quelque  rang  que  il  être  de_le  mortel  regarder  je  le  tenir  fort  misérable  se  il  ne  quitter  jamais  son  mine  redoutable  et  que  à_le  faîte  de_le  ciel  il  être  toujours  guinder  il  ne  être  point  à  mon  gré  de  plus  sot  méthode  que  de  être  emprisonner  toujours  dans  son  grandeur  et  surtout  à_le  transport  de  le  amoureux  ardeur  le  haut  qualité  devenir  fort  incommode  Jupiter  qui  sans  doute  en  plaisir  se  connaître  savoir  descendre  de_le  haut  de  son  gloire  suprême  et  pour  entrer  dans  tout  ce  que  il  il  plaire  il  sortir  tout  à  faire  de  il  même  et  ce  ne  être  plus  alors  Jupiter  qui  paraître  passer  encore  de  le  voir  de  ce  sublime  étage  dans  celui  de_le  homme  venir  prendre  tout  le  transport  que  leur  cœur  pouvoir  fournir  et  se  faire  à  leur  badinage  si  dans  le  changement  où  son  humeur  le  engager  à  le  nature  humain  il  se  en  vouloir  tenir  mais  de  voir  Jupiter  taureau  serpent  cygne  ou  quelque  autre  chose  je  ne  trouver  point  cela  beau  et  ne  je  étonner  pas  si  parfois  on  en  cause  laisser  dire  tout  le  censeur  tel  changement  avoir  leur  douceur  qui  passer  leur  intelligence  ce  dieu  savoir  ce  que  il  faire  aussi  bien  là  que  ailleurs  et  dans  le  mouvement  de  leur  tendre  ardeur  le  bête  ne  être  pas  si  bête  que  le  on  penser  revenir  à  le  objet  dont  il  avoir  le  faveur  si  par  son  stratagème  il  voir  son  flamme  heureux  que  pouvoir  il  souhaiter  et  que  être  ce  que  je  pouvoir  que  votre  cheval  par  vous  à_le  petit  pas  réduire  pour  satisfaire  à_le  vœu  de  son  âme  amoureux  de  un  nuit  si  délicieux  faire  le  plus  long \""

2. Je nettoie mon corpus

Il est absolument fondamental de nettoyer mon corpus de travail. En effet: pas et Pas ne sont pas les mêmes chaînes de caractères (il y a une majuscule dans le second), et peut-être même pas les mêmes mots (adverbe ou substantif?). Je dois donc au moins retirer les majuscules (avec la fonction tolower()), ou même lemmatiser (de préférence avec un outil spécifique, qui n’existe pas dans R).Pour rappel,nous fournissons ici le texte préalablement lemmatisé pour simplifier le travail.

2.1 Les stopwords

Comme notre objectif est d’avoir une approche thématique et conserver des mots potentiellement porteurs de sens: il faut donc retirer tous les mots les plus fréquents qui n’apportent, comme les les pronoms, les pronoms adverbiaux, les prépositions… Ces mots sont appelés des stopwords et une liste est fournie dans la fonction stopwords()

stopwords("french")
##   [1] "au"       "aux"      "avec"     "ce"       "ces"      "dans"    
##   [7] "de"       "des"      "du"       "elle"     "en"       "et"      
##  [13] "eux"      "il"       "je"       "la"       "le"       "leur"    
##  [19] "lui"      "ma"       "mais"     "me"       "même"     "mes"     
##  [25] "moi"      "mon"      "ne"       "nos"      "notre"    "nous"    
##  [31] "on"       "ou"       "par"      "pas"      "pour"     "qu"      
##  [37] "que"      "qui"      "sa"       "se"       "ses"      "son"     
##  [43] "sur"      "ta"       "te"       "tes"      "toi"      "ton"     
##  [49] "tu"       "un"       "une"      "vos"      "votre"    "vous"    
##  [55] "c"        "d"        "j"        "l"        "à"        "m"       
##  [61] "n"        "s"        "t"        "y"        "été"      "étée"    
##  [67] "étées"    "étés"     "étant"    "suis"     "es"       "est"     
##  [73] "sommes"   "êtes"     "sont"     "serai"    "seras"    "sera"    
##  [79] "serons"   "serez"    "seront"   "serais"   "serait"   "serions" 
##  [85] "seriez"   "seraient" "étais"    "était"    "étions"   "étiez"   
##  [91] "étaient"  "fus"      "fut"      "fûmes"    "fûtes"    "furent"  
##  [97] "sois"     "soit"     "soyons"   "soyez"    "soient"   "fusse"   
## [103] "fusses"   "fût"      "fussions" "fussiez"  "fussent"  "ayant"   
## [109] "eu"       "eue"      "eues"     "eus"      "ai"       "as"      
## [115] "avons"    "avez"     "ont"      "aurai"    "auras"    "aura"    
## [121] "aurons"   "aurez"    "auront"   "aurais"   "aurait"   "aurions" 
## [127] "auriez"   "auraient" "avais"    "avait"    "avions"   "aviez"   
## [133] "avaient"  "eut"      "eûmes"    "eûtes"    "eurent"   "aie"     
## [139] "aies"     "ait"      "ayons"    "ayez"     "aient"    "eusse"   
## [145] "eusses"   "eût"      "eussions" "eussiez"  "eussent"  "ceci"    
## [151] "cela"     "celà"     "cet"      "cette"    "ici"      "ils"     
## [157] "les"      "leurs"    "quel"     "quels"    "quelle"   "quelles" 
## [163] "sans"     "soi"

Il existe des listes alternatives en ligne, plus complètes:

#Donner un nom au fichier que je télécharge
mesStops="stopwords-fr.csv"
#indiquer l'URL où se trouve le document à télécharger
stopword_enLigne = "https://raw.githubusercontent.com/stopwords-iso/stopwords-fr/master/stopwords-fr.txt"
#télécharger le fichier et l'enregistrer sous le nom que je viens de lui donner
download.file(stopword_enLigne,mesStops)
#Comme c'est un tableur, je le lis avec la fonction adéquat 
stopword_enLigne = read.csv(stopword_enLigne, header=FALSE, stringsAsFactors=FALSE)[,]
#je jette un coup d'œil aux 10 premiers
head(stopword_enLigne,10)
##  [1] "a"          "abord"      "absolument" "afin"       "ah"        
##  [6] "ai"         "aie"        "aient"      "aies"       "ailleurs"

Je vais utiliser mes listes de stopwords l’une après l’autre pour nettoyer mon corpus. Pour cela j’utilise la fonction tm_map() qui permet de modifier les corpora. Dans ce cas précise j’utilise removeWords avec chacune des deux listes.

corpus_clean <- tm_map(corpus, removeWords, stopwords("french"))
## Warning in tm_map.SimpleCorpus(corpus, removeWords, stopwords("french")):
## transformation drops documents
corpus_clean <- tm_map(corpus, removeWords, stopword_enLigne)
## Warning in tm_map.SimpleCorpus(corpus, removeWords, stopword_enLigne):
## transformation drops documents
#Je jette un coup d'œil à la sixième entrée pour contrôler que tout est en ordre
inspect(corpus_clean[6])
## <<SimpleCorpus>>
## Metadata:  corpus specific: 1, document level (indexed): 0
## Content:  documents: 1
## 
## [1] " de  combien  de  frayeur  avoir    le  âme  blesser  à_le  moindre  choc  dont    entendre    voir    dans  le  horreur  de      pensée      jamais    consoler  de_le  coup  dont    être  menacer  et  de    laurier      couronne    vainqueur    part    le    avoir  à  ce  honneur  suprême  valoir  il  ce    il  en  coûter  à_le  tendresse  de    cœur    pouvoir  à    moment  trembler    ce    il  aimer  je  ne  voir    en    dont  mon  feu  ne    augmenter      marquer  à  mon  œil    cœur  bien  enflammer  et  ce  être  je    le  avouer    chose  charmant  de  trouver    de  amour  dans    objet  aimer  mais    je  le  oser  dire    scrupule  je  gêne  à_le  tendre  sentiment      je  faire  voir  et    le  bien  goûter  mon  amour  cher  Alcmène  vouloir  ne    voir  entrer    de    devoir    à      ardeur    à  mon      je  devoir  le  faveur    je  recevoir  de    et    le  qualité    je  avoir  de    époux  ne  être  point  ce    je  le  donner  ce  être  de  ce  nom  pourtant    le  ardeur    je  brûler    le  droit  de  paraître  à_le  jour  et  je  ne  comprendre    à  ce  nouveau  scrupule  dont    embarrasser    amour  ah  ce    je  avoir      de  ardeur  et  de  tendresse  passer  aussi  celui  de    époux  et    ne  savoir    dans  de_le  moment    doux    en  être  le  délicatesse    ne  concevoir  point      cœur  bien  amoureux    cent  petit  égard    attacher  avec  étude  et    faire    inquiétude  de  le  manière  de  être  heureux  en  je  beau  et  charmant  Alcmène    voir    mari    voir    amant  mais  le  amant    je  toucher  à    franchement  et  je  sens    de      le  mari  le  gêne  ce  amant  de    vœu  jaloux  à_le  dernier  point  souhaite    à  il      cœur    abandonner  et    passion  ne  vouloir  point  de  ce    le  mari  il  donner  il  vouloir  de    source  obtenir    ardeur  et  ne  vouloir      de_le  nœud  de  le  hyménée    de    fâcheux  devoir    faire  agir  le  coeur  et        le  jour  de_le    cher  faveur  le  douceur  être  empoisonner  dans  le  scrupule  enfin  dont  il  être  combattre  il  vouloir    satisfaire  à    délicatesse      le  séparer  de  avec  ce    le  blesser    le  mari  ne  être        vertu  et    de    cœur  de  bonté  revêtir  le  amant  avoir    le  amour  et    le  tendresse  amphitryon  en  vérité      moquer  de    ce  langage  et  je  avoir  peur      ne    croire    sage    de      être  écouter  ce  discours  être    raisonnable  Alcmène      ne  penser  mais      long  séjour  je      coupable  et  de_le    à_le  port  le  moment  être  presser  adieu  de  mon  devoir  le  étrange  barbarie      temps  je  arracher  de    mais  beau  Alcmène  à_le  moins      voir  le  époux  songer  à  le  amant  je    prier  je  ne  séparer  point  ce    unir  le  dieu  et  le  époux  et  le  amant  je  être  fort  précieux  ô  ciel    de  aimable  caresse  de    époux  ardemment  chérir  et    mon  traître  de  mari  être  loin  de    ce  tendresse  le  nuit    il  je  falloir  avertir  ne  avoir      à  plier      voile  et    effacer  le  étoile  le  soleil  de    lit  pouvoir  maintenant  sortir    ce  être  ainsi    le    je  quitte  et  comment  donc  ne  vouloir        de  mon  devoir  je  je  acquitter  et    de  amphitryon  je  aller    le    mais  avec  ce  brusquerie  traître  de  je    séparer  le  beau    de  fâcherie  nous  avoir    de  temps  ensemble  à  demeurer  mais    partir  ainsi  de    façon  brutal    je  dire      mot  de  douceur    régaler  diantre    vouloir      mon  esprit    aller  chercher  de_le  faribole    an  de  mariage  épuiser  le    et  depuis    long  temps  nous  nous  être    dire  regarder  traître  amphitryon  voir  combien    Alcmène  il  étaler  de  flamme  et  rougir  là-dessus  de_le    de  passion      témoigne      femme  hé  mon  Dieu  cléantir  il  être  encore  amant  il  être  certain  âge      passer  et  ce    leur  seoir  bien  dans  ce  commencement  en  nous  vieux  marier  avoir  mauvais  grâce  il  nous  faire  beau  voir  attacher  face  à  face  à  pousser  le  beau  sentiment    être  je  hors  de  état  perfide  de  espérer      cœur  auprès  de  je  soupirer  non  je  ne  avoir  garde  de  le  dire  mais  je  être    barbon    oser  soupirer  et  je  faire  crever  de  rire  mérite    pendard  ce  insigne  bonheur  de    voir    épouse    femme  de  honneur  mon  Dieu    ne  être      honnête  ce  grand  honneur  ne  je  valoir    ne  être  point    femme  de  bien  et  je  rompre      moins  le  tête  comment  de   "

Malheureusement cette commande tm_map() fonctionne mal, et il est préférable de nettoyer le texte “à l’ancienne”, en créant sa propore fonction.

#Je recharge mon corpus
corpus_clean <- tm_map(corpus_clean, PlainTextDocument)
#je crée une fonction a deux paramètres: le corpus d'entrée et la liste des stopwords.
removeStopWords <- function(corpus_a_nettoyer, stopwords_a_retirer){
  # je fais une boucle pour retirer chaque mot de `stopwords_a_retirer`
  for (word in stopwords_a_retirer){
    #J'utilise une fonction anonyme (_snonymous function_) à un paramètre qui utilise la fonction `gsub` qui remplace le mot de `stopwords_a_retirer` par rien.
    removeWord <- function(x) gsub(paste("(^|\\s)(",word,") ", sep="")," ",x)
    #on retire le mot
    corpus_a_nettoyer <- tm_map(corpus_a_nettoyer, removeWord)
  }
  #Je renvoie le résultat
  return(corpus_a_nettoyer)
}

#Je passe mon `corpus_clean` comme `corpus_a_nettoyer` et mes `stopword_enLigne` comme `stopwords_a_retirer`.
corpus_clean <- removeStopWords(corpus_clean, stopword_enLigne)

S’il reste des mots qui ne me plaisent pas, je peux continuer de les retirer en les mettant dans un vecteur

MesStopWords <- c( "à_le", "de_le", "-être", "faire", "falloir", "savoir", "pouvoir", "devoir", "devoir", "voir", "vouloir")
corpus_cleaner <- tm_map(corpus_clean, removeWords, MesStopWords)
## Warning in tm_map.SimpleCorpus(corpus_clean, removeWords, MesStopWords):
## transformation drops documents
inspect(corpus_cleaner[6])
## <<SimpleCorpus>>
## Metadata:  corpus specific: 1, document level (indexed): 0
## Content:  documents: 1
## 
## [1] "  frayeur   âme blesser  moindre choc   entendre     horreur    pensée   jamais  consoler  coup   menacer   laurier   couronne  vainqueur  part     honneur suprême valoir    coûter  tendresse   cœur    moment trembler    aimer       feu   augmenter   marquer  œil  cœur  enflammer    avouer  chose charmant  trouver   amour   objet aimer    oser   scrupule  gêne  tendre sentiment         goûter  amour  Alcmène     entrer        ardeur       faveur   recevoir     qualité     époux  point    donner   nom pourtant   ardeur   brûler   droit  paraître  jour   comprendre   scrupule   embarrasser  amour       ardeur  tendresse passer    époux       moment  doux    délicatesse   concevoir point   cœur  amoureux   petit égard  attacher  étude     inquiétude  manière  heureux   charmant Alcmène    mari    amant  amant   toucher  franchement  sens     mari  gêne  amant   vœu jaloux   point souhaite     cœur  abandonner   passion   point    mari  donner     source obtenir  ardeur      nœud  hyménée    fâcheux    agir  coeur     jour    faveur  douceur empoisonner  scrupule   combattre    satisfaire  délicatesse    séparer    blesser   mari     vertu    cœur  bonté revêtir  amant   amour   tendresse amphitryon  vérité   moquer   langage   peur     croire  sage     écouter  discours  raisonnable Alcmène    penser    long séjour    coupable     port  moment presser adieu    étrange barbarie   temps  arracher    Alcmène       époux songer  amant   prier  séparer point   unir  dieu  époux  amant  fort précieux ciel   aimable caresse   époux ardemment chérir   traître  mari loin   tendresse  nuit    avertir    plier   voile   effacer  étoile  soleil   lit   sortir       quitte          acquitter   amphitryon  aller     brusquerie traître   séparer    fâcherie    temps ensemble demeurer   partir    brutal      douceur  régaler diantre      esprit  aller chercher  faribole  an  mariage épuiser     long temps    regarder traître amphitryon    Alcmène  étaler  flamme  rougir là-dessus    passion   témoigne   femme  Dieu cléantir   amant   âge   passer    seoir   commencement  vieux marier  mauvais grâce     attacher face face pousser  sentiment    perfide  espérer   cœur auprès  soupirer   garde     barbon  oser soupirer   crever  rire mérite  pendard  insigne bonheur     épouse  femme  honneur  Dieu     honnête  grand honneur  valoir   point  femme   rompre    tête   "

Je fais de nouveau une matrice “terme/document” (DTM, Document-term matrix). On se rappelle qu’il s’agit de créer une matrice (un tableau) avec une colonne pour chaque mot de mon corpus, et un rang par texte de mon corpus.

mot1 mot2 mot3
Texte1 1 12 9
Texte2 1 154 4
dtm <- DocumentTermMatrix(corpus_cleaner)
rownames(dtm) <- theatre$genre

2.2 Les mots peu fréquents

Je peux désormais observer la fréquence des mots: je retrouve la loi de Zipf dans la distribution de mes données

freq <- as.data.frame(colSums(as.matrix(dtm)))
colnames(freq) <- c("frequence")
#Comme je vais dessiner un graph, j'ai besoin d'une nouvelle librairie: `ggplot2`
if (!require("ggplot2")){
  install.packages("ggplot2")
  library("ggplot2")
}
## Le chargement a nécessité le package : ggplot2
## 
## Attachement du package : 'ggplot2'
## L'objet suivant est masqué depuis 'package:NLP':
## 
##     annotate
#Je dessine mon graph
ggplot(freq, aes(x=frequence)) + geom_density()

Je peux compter les mots avec des fréquences faibles, par exemple avec moins de 100 occurrences

#Je retire tous les mots qui apparaissent entre 0 et 400 fois (on peut remplacer 400 par 100, ou même 10 si le corpus est trop gros)
motsPeuFrequents <- findFreqTerms(dtm, 0, 400)
#Si vous êts sur windows, décommentez la ligne suivante
#Encoding(motsPeuFrequents)<-"latin-1"
length(motsPeuFrequents)
## [1] 8550
head(motsPeuFrequents,50)
##  [1] "admirer"     "agir"        "aile"        "aise"        "alcmène"    
##  [6] "allure"      "amoureux"    "amphitryon"  "ardeur"      "arrêter"    
## [11] "artifice"    "asseoir"     "aventure"    "aviser"      "badinage"   
## [16] "beauté"      "besoin"      "bout"        "béotique"    "bête"       
## [21] "cause"       "censeur"     "cesse"       "chaise"      "chaleur"    
## [26] "changement"  "charmant"    "cheval"      "chérir"      "commander"  
## [31] "comprendre"  "cruel"       "cygne"       "daigner"     "dame"       
## [36] "decorum"     "descendre"   "destin"      "devenir"     "deviner"    
## [41] "divinité"    "don"         "doucement"   "douceur"     "doute"      
## [46] "doux"        "déguisement" "délicieux"   "désirer"     "emploi"

Je peux aussi compter et afficher les mots les plus fréquents, par exemple avec plus de 400 occurrences

motsTresFrequents <- findFreqTerms(dtm, 401, Inf)
#Si vous êts sur windows, décommentez la ligne suivante
#Encoding(motsTresFrequents)<-"latin-1"
length(motsTresFrequents)
## [1] 65
head(motsTresFrequents,50)
##  [1] "aimer"     "aller"     "amour"     "attendre"  "chose"     "ciel"     
##  [7] "connaître" "coup"      "croire"    "cœur"      "dieu"      "donner"   
## [13] "foi"       "fort"      "gloire"    "homme"     "jamais"    "jour"     
## [19] "mal"       "mettre"    "oui"       "passer"    "penser"    "plaire"   
## [25] "point"     "prendre"   "seigneur"  "soin"      "sortir"    "trouver"  
## [31] "venir"     "âme"       "œil"       "affaire"   "esprit"    "grand"    
## [37] "honneur"   "madame"    "monde"     "monsieur"  "mort"      "nom"      
## [43] "porter"    "raison"    "temps"     "chercher"  "entendre"  "lieu"     
## [49] "main"      "perdre"

Je fais un très grand ménage, avec une fonction que je crée pour retirer les mots les moins fréquents:

#Je crée une fonction `grandMenage`
grandMenage <- function(corpus_a_nettoyer, mots_peu_importants){
  #Afin de simplifier le travail (de mon ordinateur), je vais rassembler les mots à retirer en groupe 500 tokens, que je vais traiter séparément.
    chunk <- 500
    #Je compte le nombre de mots à retirer
    n <- length(mots_peu_importants)
    #Je compte les groupes de 500 (ici 17.05), j'arrondis au plus petit entier supérieur (ici 18) 
    r <- rep(1:ceiling(n/chunk),each=chunk)[1:n]
    #Je constitue mes lots sur la base du décompte précédemment mentionné
    d <- split(mots_peu_importants,r)
    #Je fais une boucle: pour retirer les mots du corpus, morceau par morceau
    for (i in 1:length(d)) {
        corpus_a_nettoyer <- tm_map(corpus_a_nettoyer, removeWords, c(paste(d[[i]])))
    }
    #Je renvoie un résultat
    return(corpus_a_nettoyer)
}
# J'utilise ma fonction avec `corpus_clean` comme ` corpus_a_nettoyer` et `motsPeuFrequents` comme `mots_peu_importants`
corpus_cleanSuperClean <- grandMenage(corpus_cleaner, motsPeuFrequents)
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents

## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents

## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents

## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents

## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents

## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents

## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents

## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents

## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents

## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents

## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents

## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents

## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents

## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents

## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents

## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents

## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents

## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents

Je redéfinis ma matrice à partir de mon nouveau corpus

dtm <- DocumentTermMatrix(corpus_cleanSuperClean)
rownames(dtm) <- theatre$genre
freq <- as.data.frame(colSums(as.matrix(dtm)))
colnames(freq) <- c("frequence")
#Je fais un petit graph
ggplot(freq, aes(x=frequence)) + geom_density()

Je nettoye un peu ma DTM pour éliminer les rangs vides

rowTotals <- apply(dtm , 1, sum)      #Find the sum of words in each Document
dtm_clean   <- dtm[rowTotals> 0, ]    #remove all docs without words

3. Topic modeling

Remarque préliminaire: le topic modeling requiert des (très) grands corpus, si possible en centaines de documents. Pas de panique cependant: une manière de les obtenir est de diviser chaque textes en plusieurs documents qui forment une unité sémantique. Par exemple le chapitre, la scène, le paragraphe, ou bien (comme c’est le cas pour notre exercice) de 1000 mots.

3.1 Explication théorique

Un thème (topic) est un clusters de mots, i.e. une récurrence de co-occurrence.

100% center

Source: Wikisource

Le principe du topic modeling est proche de celui de surligner un texte avec plusieurs couleurs: une pour chaque sujet, thème ou topic.

100% center

Une telle image soulève deux questions sur lesquelles nous reviendront plus tard: * un article peut-il contenir plusieurs sujets? * un mot peut-il n’appartenir qu’à un seul sujet?

Afin de reconnaître ces sujets, on va recourir à une allocation de Dirichlet latente ( Latent Dirichlet allocation, LDA). * C’est une approche non supervisée, c’est-à-dire qu’elle ne nécessite pas d’annotation préalable de données. * Il nous faut définir à l’avance un nombre de sujets/thèmes (infra la variable k)

Le LDA est modèle génératif probabiliste permettant d’expliquer des ensembles d’observations, par le moyen de groupes non observés, eux-mêmes définis par des similarités de données.

150% center

Source: wikipedia

Dans ce graph: * M est le nombre de documents (corpus) * N est le nombre de mots (document) * W est un mot observé

La partie latente (cachée): * Z est un topic attribué à un w * θ est le mélange des topics à l’échelle du document

Deux paramètres pour la distribution * α est la distribution par document. Si sa valeur est élevée, le document tend à contenir plusieurs topics, si la valeur est faible le nombre de topics est limité * β est la distribution par topic. Si sa valeur est élevée, un même mot se retrouve dans plusieurs topics (qui se ressemblent donc), si la valeur est faible les similarités entre les topics est faible

150% center

Source: wikipedia

3.2 Une LDA

Le modèle va classer aléatoirement tous les mots en n sujets, et tenter d’affiner cette répartition de manière itérative en observant les contextes:

#J'installe une nouvelle librairie pour le _topic modeling_
if(!require("topicmodels")){
  install.packages("topicmodels")
  library("topicmodels")
}
## Le chargement a nécessité le package : topicmodels
#Je vais partir sur une classification en deux _topics_
k = 2
lda_2 <- LDA(dtm_clean, k= k, control = list(seed = 1234))
##Je tente avec trois, pour voir…
lda_3 <- LDA(dtm_clean, k= k+1, control = list(alpha = 0.1))

Le résultat produit est une matrice avec pour chaque mot la probabilité qu’il appartienne à un des différents topics. On donne un score β, qui est celui présenté infra.

topics <- tidy(lda_2, matrix = "beta")
topics
## # A tibble: 848 × 3
##    topic term         beta
##    <int> <chr>       <dbl>
##  1     1 aimer    0.0200  
##  2     2 aimer    0.0202  
##  3     1 alcmène  0.000349
##  4     2 alcmène  0.00106 
##  5     1 aller    0.0303  
##  6     2 aller    0.0571  
##  7     1 amour    0.0130  
##  8     2 amour    0.0302  
##  9     1 attendre 0.00547 
## 10     2 attendre 0.0151  
## # … with 838 more rows

3.3 Les paramètres de Gibbs

Les paramètres de Gibbs permettent une sophistication du système précédent. C’est une probabilité conditionnelle qui s’appuie, pour calculer le β d’un mot, sur le β des mots voisins. Pour ce faire nous devons déterminer: 1. À quel point un document aime un topic 2. À quel pount un topic aime un mot

Un document:

Voiture Autoroute Musique Vélo Vacances
1 ?? 2 1 3

Sachant que le décompte est le suivant

topic 1 topic 2 topic 3
Voiture 34 49 75
Autoroute 150 50 70
Musique 34 4 170
Vélo 543 2 150
Vacances 23 70 563

Le topic 1 est le plus représenté dans le document, et Autoroute est déjà surreprésenté dans le décompte, donc on update le tout

Voiture Autoroute Musique Vélo Vacances
1 1 2 1 3
topic 1 topic 2 topic 3
Voiture 34 49 75
Autoroute 151 50 70
Musique 34 4 170
Vélo 543 2 150
Vacances 23 70 563

Nous devons d’abord déterminer le nombre optimal de topics

#J'installe une nouvelle librairie pour déterminer le nombre de topics
if(!require("ldatuning")){
  install.packages("ldatuning")
  library("ldatuning")
}
## Le chargement a nécessité le package : ldatuning
#J'exécute le calcul
topicsNumber <- FindTopicsNumber(
  #La DTM que j'utilise
  dtm_clean,
  #Le nombre de possibilités que je teste
  topics = seq(from = 2, to = 20, by = 1),
  #Les métriques utilisées
  metrics = c("Griffiths2004", "CaoJuan2009", "Arun2010", "Deveaud2014"),
  method = "Gibbs",
  control = list(seed = 77),
  verbose = TRUE
)
## fit models... done.
## calculate metrics:
##   Griffiths2004... done.
##   CaoJuan2009... done.
##   Arun2010... done.
##   Deveaud2014... done.
#J'affiche le résultat
FindTopicsNumber_plot(topicsNumber)
## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

## Set parameters for Gibbs sampling
#Le modèle va tourner 2000 fois avant de commencer à enregistrer les résultats
burnin <- 2000
#Après cela il va encore tourner 2000 fois
iter <- 2000
# Il ne va enregistrer le résultat que toutes les 500 itérations
thin <- 500
#seed et nstart pour la reproductibilité
SEED=c(1, 2, 3, 4, 5)
seed <-SEED
nstart <- 5
#Seul meilleur modèle est utilisé
best <- TRUE
#7 topics
lda_gibbs_7 <- LDA(dtm_clean, 7, method="Gibbs", control=list(nstart=nstart, seed=seed, best=best, burnin=burnin, iter=iter, thin=thin))
#19 topics
lda_gibbs_19 <- LDA(dtm_clean, 19, method="Gibbs", control=list(nstart=nstart, seed=seed, best=best, burnin=burnin, iter=iter, thin=thin))

Je peux désormais voir les premiers résultats pour chacun des modèles. Il s’agit de de mots dont la fréquence d’utilisation est corrélée

"LDA 2"
## [1] "LDA 2"
termsTopic <- as.data.frame(terms(lda_2,10))
head(termsTopic,11)
##     Topic 1  Topic 2
## 1     venir    point
## 2  monsieur    aller
## 3     point     cœur
## 4   prendre    amour
## 5     aller   donner
## 6    madame monsieur
## 7     homme   croire
## 8    jamais    chose
## 9       œil   mettre
## 10     père      oui
"LDA 3"
## [1] "LDA 3"
termsTopic <- as.data.frame(terms(lda_3,10))
head(termsTopic,11)
##    Topic 1  Topic 2  Topic 3
## 1     cœur monsieur seigneur
## 2    point    aller    aller
## 3   madame    point    point
## 4    aimer    venir      œil
## 5    amour    chose     cœur
## 6    aller      oui     dieu
## 7  prendre   donner   madame
## 8      âme    homme      roi
## 9    venir  prendre    venir
## 10  croire     père     fils
"LDA GIBBS 7"
## [1] "LDA GIBBS 7"
termsTopic <- as.data.frame(terms(lda_gibbs_7,10))
head(termsTopic,11)
##     Topic 1 Topic 2   Topic 3 Topic 4  Topic 5  Topic 6  Topic 7
## 1     point prendre     aller  madame     cœur monsieur     dieu
## 2     venir   grand     point    ciel    amour    chose seigneur
## 3      père  esprit     venir  sortir    aimer    homme     fils
## 4     fille     mal      coup    jour      âme     fort      roi
## 5       oui trouver    porter   frère   croire      oui      œil
## 6  demander  mettre  entendre    mort      œil    monde     sang
## 7     aller   point    donner     vie     soin   donner craindre
## 8   honneur  plaire     mieux  mourir   gloire    femme     main
## 9    croire  jamais       foi  perdre attendre  affaire      nom
## 10   jamais  raison connaître    main     lieu  trouver chercher
"LDA GIBBS 19"
## [1] "LDA GIBBS 19"
termsTopic <- as.data.frame(terms(lda_gibbs_19,10))
head(termsTopic,11)
##      Topic 1   Topic 2  Topic 3  Topic 4  Topic 5  Topic 6  Topic 7   Topic 8
## 1     madame     grand seigneur     cœur   croire      oui monsieur     aller
## 2     croire    esprit      œil      âme    point   donner    chose     venir
## 3      point   prendre attendre      œil    aller     fort   donner       foi
## 4       soin      fort     jour   sortir      foi  trouver  affaire    donner
## 5     perdre   trouver craindre     soin   passer    venir   mettre  attendre
## 6       jour      vrai     rome souffrir   jamais    grand    homme       oui
## 7     penser    jamais entendre   jamais    grâce    point    monde      -ten
## 8  connaître    passer   gloire    amour   penser   raison  prendre connaître
## 9      amour      lieu     lieu  trouver souffrir entendre   porter    porter
## 10       foi connaître    temps  alcmène   raison  léandre     fort  entendre
##      Topic 9  Topic 10 Topic 11 Topic 12 Topic 13 Topic 14  Topic 15 Topic 16
## 1        roi      père    aimer     fils  prendre    frère      ciel    chose
## 2   chercher     fille    amour seigneur      mal   mourir   honneur    homme
## 3     gloire     aller     cœur     sang   mettre     mort     point    femme
## 4       lieu     point      œil      œil    point     main  demander    monde
## 5      grand  demander   plaire craindre   plaire     sang       vie  trouver
## 6   attendre     venir     main     père   raison   sortir  souffrir  affaire
## 7  connaître    donner   myrtil     mort   croire      vie connaître     vrai
## 8  alexandre    raison   gloire chercher   penser   perdre   prendre    mieux
## 9     croire iphigénie xipharès  pyrrhus   jamais     ciel     grâce aristote
## 10      main   honneur chercher    grèce tartuffe     jour       don   plaire
##    Topic 17 Topic 18 Topic 19
## 1     point     dieu    venir
## 2    donner     jour     coup
## 3     mieux     ciel   porter
## 4    plaire     main   jamais
## 5     venir      nom entendre
## 6     grâce   sortir   sortir
## 7     temps      œil    grand
## 8    penser entendre   perdre
## 9    passer    temps   passer
## 10     vrai    david    aller

Nous allons utiliser lda_gibbs_2 et construire une matrice avec les β des tokens (pour les ɣ, et donc des probabilités par document, on aurait mis matrix = "gamma"). Chaque token est répété deux fois, avec une probabilité pour chaque topic:

topics <- tidy(lda_gibbs_7, matrix = "beta")
topics
## # A tibble: 2,968 × 3
##    topic term         beta
##    <int> <chr>       <dbl>
##  1     1 aimer   0.0000136
##  2     2 aimer   0.0000134
##  3     3 aimer   0.000150 
##  4     4 aimer   0.0000134
##  5     5 aimer   0.138    
##  6     6 aimer   0.0000118
##  7     7 aimer   0.0000119
##  8     1 alcmène 0.0000136
##  9     2 alcmène 0.0000134
## 10     3 alcmène 0.0000136
## # … with 2,958 more rows

4. Visualisation

#Je vais encore solliciter une nouvelle librairie
if (!require("dplyr")){
   install.packages("dplyr")
  library("dplyr")
}
## Le chargement a nécessité le package : dplyr
## 
## Attachement du package : 'dplyr'
## Les objets suivants sont masqués depuis 'package:stats':
## 
##     filter, lag
## Les objets suivants sont masqués depuis 'package:base':
## 
##     intersect, setdiff, setequal, union
#Je récupère mes mots
top_terms <- topics %>%
  group_by(topic) %>%
  top_n(10, beta) %>%
  ungroup()  %>%
  arrange(topic, -beta)
#Je fais un graph
top_terms %>%
  mutate(term = reorder_within(term, beta, topic)) %>%
  ggplot(aes(term, beta, fill = factor(topic))) + geom_col(show.legend = FALSE) +
                                                  facet_wrap(~ topic, scales = "free") +
                                                  coord_flip() +
                                                  scale_x_reordered()

Je vais désormais associer chaque mot à l’un des 5 genres possibles, pour déterminer auquel mes tokens sont rattachés, et découvrir (potentiellement quel genre se cacher derrière quel topic

if (!require("reshape2")){
  install.packages("reshape2")
  library("reshape2")
}
## Le chargement a nécessité le package : reshape2
df <- melt(as.matrix(dtm_clean))
df <- df[df$Terms %in% findFreqTerms(dtm_clean, lowfreq = 800), ]
ggplot(df, aes(as.factor(Docs), Terms, fill=log(value))) +
                                             geom_tile() +
                                             xlab("Genres") +
                                             scale_fill_continuous(low="#FEE6CE", high="#E6550D") +
                                             theme(axis.text.x = element_text(angle=90, hjust=1))

tt <- posterior(lda_gibbs_7)$terms
melted = melt(tt[,findFreqTerms(dtm_clean, 1000,10000)])

colnames(melted) <- c("Topics", "Terms", "value")
melted$Topics <- as.factor(melted$Topics)
ggplot(data = melted, aes(x=Topics, y=Terms, fill=value)) + 
                                              geom_tile() +
                                              theme(text = element_text(size=35))

tt <- posterior(lda_gibbs_19)$terms
melted = melt(tt[,findFreqTerms(dtm_clean, 1000,10000)])

colnames(melted) <- c("Topics", "Terms", "value")
melted$Topics <- as.factor(melted$Topics)
ggplot(data = melted, aes(x=Topics, y=Terms, fill=value)) + 
                                              geom_tile() +
                                              theme(text = element_text(size=35))

On peut aussi observer le score gamma, c’est-à-dire la probabilté qu’un document contienne un sujet:

DocumentTopicProbabilities <- as.data.frame(lda_gibbs_19@gamma)
rownames(DocumentTopicProbabilities) <- rownames(corpus_cleanSuperClean)
head(DocumentTopicProbabilities)
##           V1         V2         V3         V4         V5         V6         V7
## 1 0.03103914 0.03958614 0.03958614 0.07377418 0.08232119 0.03958614 0.02249213
## 2 0.08859649 0.10526316 0.04692982 0.13026316 0.03026316 0.02192982 0.08026316
## 3 0.06009117 0.06009117 0.04434314 0.06796519 0.03646913 0.08371322 0.02072109
## 4 0.02174859 0.09612875 0.02174859 0.07133536 0.03001305 0.06307090 0.03001305
## 5 0.02349624 0.12171053 0.02349624 0.07706767 0.03242481 0.03242481 0.04135338
## 6 0.03301435 0.05119617 0.02392344 0.15119617 0.07846890 0.03301435 0.02392344
##           V8         V9        V10        V11        V12        V13        V14
## 1 0.03103914 0.03103914 0.02249213 0.03958614 0.02249213 0.05668016 0.02249213
## 2 0.06359649 0.03026316 0.03026316 0.02192982 0.03026316 0.03026316 0.02192982
## 3 0.08371322 0.04434314 0.02072109 0.04434314 0.02072109 0.07583920 0.04434314
## 4 0.03827751 0.02174859 0.02174859 0.02174859 0.02174859 0.04654197 0.05480644
## 5 0.03242481 0.06813910 0.04135338 0.05028195 0.04135338 0.08599624 0.05921053
## 6 0.03301435 0.04210526 0.03301435 0.09665072 0.02392344 0.02392344 0.02392344
##          V15        V16        V17        V18        V19
## 1 0.05668016 0.06522717 0.06522717 0.19343230 0.06522717
## 2 0.05526316 0.05526316 0.03859649 0.08026316 0.03859649
## 3 0.05221716 0.07583920 0.04434314 0.06009117 0.06009117
## 4 0.04654197 0.07133536 0.08786429 0.12092214 0.11265768
## 5 0.03242481 0.07706767 0.02349624 0.05921053 0.07706767
## 6 0.06937799 0.06028708 0.07846890 0.08755981 0.03301435

Nous allons désormais faire des word clouds. Pour cela appelons (installons?) les libraries suivantes:

if (!require("wordcloud")){
   install.packages("wordcloud")
  library("wordcloud")
}
## Le chargement a nécessité le package : wordcloud
## Le chargement a nécessité le package : RColorBrewer
if (!require("RColorBrewer")){
   install.packages("RColorBrewer")
  library("RColorBrewer")
}
if (!require("wordcloud2")){
   install.packages("wordcloud2")
  library("wordcloud2")
}
## Le chargement a nécessité le package : wordcloud2

je récupère les mots et je les associe à leur 𝛃

tm <- posterior(lda_gibbs_7)$terms
data = data.frame(colnames(tm))
head(data)
##   colnames.tm.
## 1        aimer
## 2      alcmène
## 3        aller
## 4        amour
## 5     attendre
## 6        chose

Je produis une visualisation par topic

for(topic in seq(k)){
    data$topic <-tm[topic,]
    #text(x=0.5, y=1, paste("V",topic, sep=""),cex=0.6)
    wordcloud(
      words = data$colnames.tm.,
      freq = data$topic,
      #sous ce seuil, les mots ne seront pas affichés
      min.freq=0.0002,
      #nombre maximum de mots à afficher
      max.words=30,
      #Si faux, en ordre croissant
      random.order=FALSE,
      #% de mots à 90°
      rot.per=.35,
      #taille du graph
      scale=c(10,10),
      #couleurs
      colors = brewer.pal(5, "Dark2")
      # il est possible de rentrer directement les couleurs qui nous intéressent
      #c("red", "blue", "yellow", "chartreuse", "cornflowerblue", "darkorange")
    )
}
## Warning in wordcloud(words = data$colnames.tm., freq = data$topic, min.freq =
## 2e-04, : ascagne could not be fit on page. It will not be plotted.

Finissons avec un peu de mauvais goût, grâce au package wordcloud2

wordcloud2(data = data,
          size=0.4,
          color= "random-light",
          backgroundColor = "pink",
          shape = 'star',
          rotateRatio=1
    )

Rermerciements

Les données d’entraînement ont été créées par JB Camps (ENC). Des morceaux de ce script (notamment pour le nettoyage des données) proviennent d’un cours de Mattia Egloff (UniL).